#include <stdio.h>
#include <stdlib.h>
#include "deviser.h"
#include "gc.h"

unsigned int DVS_ERROR_RETURN = 0;

unsigned int funcp(cell c) {
	return lfuncp(&c) || cfuncp(&c);
}

int list_length(cell l) {
	int i = 0;
	for(; !nullp(&l); i++, l = cdr(&l));
	return i;
}

int listp(cell c) {
	if(nullp(&c)) return 1;
	return consp(&c) && listp(cdr(&c));
}

cell dvs_error(char* message) {
	printf("%s\n", message);
	if(DVS_ERROR_RETURN)
		return 0;
	exit(1);
}

cell dvs_eq(cell c) {
	if(nullp(&c)) return mk_bool(1);
	cell f = car(&c);
	c = cdr(&c);
	while(!nullp(&c)) {
		if(!eeqp(f, car(&c))) return mk_bool(0);
		c = cdr(&c);
	}
	return mk_bool(1);
}

cell dvs_eqv(cell c) {
	if(nullp(&c)) return mk_bool(1);
	cell f = car(&c);
	c = cdr(&c);
	while(!nullp(&c)) {
		if(!eeqvp(f, car(&c))) return mk_bool(0);
		c = cdr(&c);
	}
	return mk_bool(1);
}

cell dvs_list(cell c) {
	return c; //c is already a fresh list of all args
}

cell dvs_car(cell c) {
	if(nullp(&c)) return dvs_error("car must have at least one argument");
	c = car(&c);
	if(consp(&c)) return car(&c);
	else return dvs_error("car must have a cons");
	return 0;
}

cell dvs_cdr(cell c) {
	if(nullp(&c)) return dvs_error("car must have at least one argument");
	c = car(&c);
	if(consp(&c)) return cdr(&c);
	else return dvs_error("cdr must have a cons");
	return 0;
}

cell dvs_plus(cell c) {
	int ret = 0;
	while(!nullp(&c)) {
		cell t = car(&c); //XXX
		if(numberp(&t)) ret += number_to_cint(car(&c));
		c = cdr(&c);
	}
	return mk_number(ret);
}

cell dvs_minus(cell c) {
	if(nullp(&c)) return mk_number(0);

	int ret = number_to_cint(car(&c));
	c = cdr(&c);

	while(!nullp(&c)) {
		cell t = car(&c); //XXX
		if(numberp(&t)) ret -= number_to_cint(car(&c));
		c = cdr(&c);
	}
	return mk_number(ret);
}

cell dvs_print(cell c) {
	lisp_print(c, stdout);
	printf("\n");
	return mk_bool(1);
}

cell mk_default_env()
{
	ext_ref env;
	env.ref = NULL;
	env.next = root_set;
	root_set = &env;

	env.ref = mk_env();
	add_to_env(env.ref, mk_symbol("fn", 2), mk_symbol("fn", 2));
	add_to_env(env.ref, mk_symbol("quote", 5), mk_symbol("quote", 5));
	add_to_env(env.ref, mk_symbol("define", 6), mk_symbol("define", 6));
	add_to_env(env.ref, mk_symbol("list", 4), mk_cfunc(dvs_list));
	add_to_env(env.ref, mk_symbol("car", 3), mk_cfunc(dvs_car));
	add_to_env(env.ref, mk_symbol("cdr", 3), mk_cfunc(dvs_cdr));
	add_to_env(env.ref, mk_symbol("true", 4), mk_bool(1));
	add_to_env(env.ref, mk_symbol("false", 5), mk_bool(0));
	add_to_env(env.ref, mk_symbol("if", 2), mk_symbol("if", 2));
	add_to_env(env.ref, mk_symbol("set!", 4), mk_symbol("set!", 4));
	add_to_env(env.ref, mk_symbol("+", 1), mk_cfunc(dvs_plus));
	add_to_env(env.ref, mk_symbol("-", 1), mk_cfunc(dvs_minus));
	add_to_env(env.ref, mk_symbol("eq", 2), mk_cfunc(dvs_eq));
	add_to_env(env.ref, mk_symbol("eqv", 3), mk_cfunc(dvs_eqv));
	add_to_env(env.ref, mk_symbol("print", 5), mk_cfunc(dvs_print));
	root_set = env.next;
	return env.ref;
}
